Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/indexed.fr_/indexed.fr

Text File | 1995-07-04 | 16KB | 541 lines

VERSION 4.00
Begin VB.Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Indexed Browser"
   ClientHeight    =   2745
   ClientLeft      =   1965
   ClientTop       =   2055
   ClientWidth     =   6420
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   3435
   Left            =   1905
   LinkTopic       =   "Form1"
   ScaleHeight     =   2745
   ScaleWidth      =   6420
   Top             =   1425
   Width           =   6540
   Begin VB.CommandButton cmdMove
      Caption         =   ">|"
      Height          =   375
      Index           =   3
      Left            =   3780
      TabIndex        =   9
      Top             =   1980
      Width           =   375
   End
   Begin VB.CommandButton cmdMove
      Caption         =   ">"
      Height          =   375
      Index           =   2
      Left            =   3420
      TabIndex        =   8
      Top             =   1980
      Width           =   375
   End
   Begin VB.CommandButton cmdMove
      Caption         =   "<"
      Height          =   375
      Index           =   1
      Left            =   3060
      TabIndex        =   7
      Top             =   1980
      Width           =   375
   End
   Begin VB.CommandButton cmdMove
      Caption         =   "|<"
      Height          =   375
      Index           =   0
      Left            =   2700
      TabIndex        =   6
      Top             =   1980
      Width           =   375
   End
   Begin VB.TextBox txtISBN
      DataField       =   "ISBN"
      DataSource      =   "dtaTitles"
      Height          =   315
      Left            =   1860
      MaxLength       =   13
      TabIndex        =   2
      Top             =   1380
      Width           =   1635
   End
   Begin VB.TextBox txtYearPublished
      DataField       =   "Year Published"
      DataSource      =   "dtaTitles"
      Height          =   285
      Left            =   1860
      TabIndex        =   1
      Top             =   900
      Width           =   735
   End
   Begin VB.TextBox txtTitle
      DataField       =   "Title"
      DataSource      =   "dtaTitles"
      Height          =   555
      Left            =   1860
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   180
      Width           =   4095
   End
   Begin VB.Label Label3
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "ISBN:"
      Height          =   195
      Left            =   1200
      TabIndex        =   5
      Top             =   1440
      Width           =   510
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Year Published:"
      Height          =   195
      Left            =   360
      TabIndex        =   4
      Top             =   960
      Width           =   1350
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Title:"
      Height          =   195
      Left            =   1200
      TabIndex        =   3
      Top             =   180
      Width           =   450
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuEdit
      Caption         =   "&Edit"
      Begin VB.Menu mnuEditUndo
         Caption         =   "&Undo"
         Shortcut        =   %{BKSP}
      End
   End
   Begin VB.Menu mnuData
      Caption         =   "&Data"
      Begin VB.Menu mnuSaveRecord
         Caption         =   "&Save Record"
      End
      Begin VB.Menu mnuDataIndex
         Caption         =   "&Index"
         Begin VB.Menu mnuDataIndexISBN
            Caption         =   "&ISBN"
         End
         Begin VB.Menu mnuDataIndexTitle
            Caption         =   "&Title"
         End
      End
      Begin VB.Menu mnuDataSeek
         Caption         =   "See&k"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private rs As Recordset
Private DataChanged As Boolean
Private MoveCancelled As Boolean



Private Sub cmdMove_Click(Index As Integer)

    ' The user clicked one of the move buttons. The button clicked is
    ' passed as the Index argument. The four local Const declarations
    ' represent the possible values of Index

    Const MOVE_FIRST = 0
    Const MOVE_PREVIOUS = 1
    Const MOVE_NEXT = 2
    Const MOVE_LAST = 3

    Dim msg As String

    If DataChanged Then

        ' The data have changed, so verify that the user wants to save
        ' the changes to the database.
        msg = "Do you want to save the changes you've made "
        msg = msg & " to the current Title?"

        Select Case MsgBox(msg, vbQuestion + vbYesNoCancel)
            Case vbYes

                ' The user wants to save.
                SaveRecord
            Case vbNo

                ' The user does not want to save, so simply do nothing

            Case vbCancel

                ' The user clicked Cancel, so set the flag to abort the move
                MoveCancelled = True
        End Select
    End If

    If Not MoveCancelled Then

        ' The move has not been cancelled, so move to the indicated record.
        Select Case Index
            Case MOVE_FIRST
                rs.MoveFirst
            Case MOVE_PREVIOUS
                rs.MovePrevious

                ' If we were already on the first record, moving to the
                ' previous record put us at BOF. That's not good, so
                ' so reposition on the first record.
                If rs.BOF Then rs.MoveFirst
            Case MOVE_NEXT
                rs.MoveNext

                ' If we were already on the last record, moving to the
                ' next record put us at EOF. That's not good, so
                ' so reposition on the last record.
                If rs.EOF Then rs.MoveLast
            Case MOVE_LAST
                rs.MoveLast
        End Select

        ' Read the values from the new current record and display them
        ' in the controls on the form.
        DisplayRecord
    End If

End Sub
Private Sub DisplayRecord()

    ' Check each field in the recordset to make sure it's non-null.
    ' If it is, display it in the corresponding control. If it is null,
    ' display an empty string in the control.
    If Not IsNull(rs![Title]) Then txtTitle = rs![Title] Else txtTitle = ""
    If Not IsNull(rs![Year Published]) Then txtYearPublished = rs![Year Published] Else txtYearPublished = ""
    If Not IsNull(rs![ISBN]) Then txtISBN = rs![ISBN] Else txtISBN = ""

    ' Clear the DataChanged flag to indicate there's no need to save the
    ' record.
    DataChanged = False
End Sub

Private Sub SaveRecord()
    Dim msg As String

    On Error GoTo SaveError

    ' Verify that each control has a legal value. If a control has an illegal
    ' value, create a string explaining the problem and set the focus to the
    ' control.
    If txtTitle = "" Then
         msg = "You must enter a title."
         txtTitle.SetFocus
    ElseIf txtISBN = "" Then
         msg = "You must enter an ISBN."
         txtISBN.SetFocus
    ElseIf txtYearPublished <> "" And Not IsNumeric(txtYearPublished) Then
        msg = "The Year Published must be numeric."
        txtYearPublished.SetFocus
    End If

    If msg = "" Then

        ' No error message was built, so the data checked out okay. Set
        ' the hourglass cursor.
        Screen.MousePointer = 11

        ' Copy the current record from the recordset rs into the copy buffer.
        rs.Edit

            ' Update the fields in the copy buffer.
            WriteRecord

        ' Write the copy buffer to the database.
        rs.UPDATE


        ' Clear the DataChanged flag to indicate there's no need to save the
        ' record.
        DataChanged = False

        ' Restore the cursor to the default.
        Screen.MousePointer = 0
    Else

        ' There's an error message, so display it.
        MsgBox msg, vbExclamation
        MoveCancelled = True
    End If

Exit Sub

SaveError:

    ' An error was generated by Visual Basic or the Jet engine.
    ' Set the cursor to the default and display the error message.
    Screen.MousePointer = 0
    MsgBox Err.Description

Exit Sub

End Sub

Private Sub WriteRecord()

    ' Update each field in the recordset from the value of the associated
    ' control on the form.
    rs![Title] = txtTitle
    rs![Year Published] = txtYearPublished
    rs![ISBN] = txtISBN
End Sub

Private Sub Form_Load()
    Dim db As DATABASE
    Dim dbName As String

    On Error GoTo LoadError

  ' Get the database name and open the database.
    dbName = BiblioPath()       ' BiblioPath is a function in READINI.BAS
    Set db = DBEngine.Workspaces(0).OpenDatabase(dbName)

    ' Open the recordset.
    Set rs = db.OpenRecordset("Titles", dbOpenTable)


    If rs.RecordCount > 0 Then

        ' We have at least one record, so display the values of the first
        ' record in the recordset in the controls on the form.
        DisplayRecord

        ' Set the current index to the default, which is the primary key.
        UpdateMenuStatus "PrimaryKey"

    Else

        ' An empty recordset, so display an explanation, then terminate.
        MsgBox "There are no records in the Titles table.", vbCritical
        End
    End If
Exit Sub

LoadError:

    ' An error was generated by Visual Basic or the Jet engine.
    ' Display the error message and terminate gracefully.
    MsgBox Err.Description
End

End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    ' Somebody wants to close the form.

    Dim msg As String

    On Error GoTo CloseError

    If DataChanged Then

        ' The user has changed data in the current record. Ask whether
        ' the user wants to save the changes.
        msg = "Do you want to save changes to the current record?"

        Select Case MsgBox(msg, vbQuestion + vbYesNoCancel)
            Case vbYes

                ' The user said yes, so save the changes.
                SaveRecord

            Case vbNo

                ' The user said no, so do nothing.
            Case vbCancel

                ' The user clicked Cancel, so cancel the unload event.
                Cancel = True
        End Select
    End If

Exit Sub
CloseError:
    Dim errorMsg As String

    ' An error was generated by Visual Basic or the Jet engine.
    ' Display the error message.
    errorMsg = "Error " & Err & " (" & Error$ & ") occurred."
    errorMsg = errorMsg & " RECORD HAS NOT BEEN SAVED!!"
    MsgBox errorMsg, vbExclamation

    ' Set the DataChanged flag.
    txtTitle.DataChanged = True
Exit Sub

End Sub

Private Sub mnuEditUndo_Click()

    ' The user clicked Undo, so refresh the controls on the form with
    ' the contents of the current record in the recordset.
    DisplayRecord
End Sub

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Private Sub mnuSaveRecord_Click()

    ' If the record needs to be saved, save it. Otherwise, just ignore
    ' the click.
    If DataChanged Then SaveRecord
End Sub

Private Sub txtISBN_Change()

    ' The user has made a change, so set the DataChanged flag to true to
    ' indicate that the record needs to be saved.
    DataChanged = True
End Sub

Private Sub txtTitle_Change()

    ' The user has made a change, so set the DataChanged flag to true to
    ' indicate that the record needs to be saved.
    DataChanged = True
End Sub

Private Sub txtYearPublished_Change()

    ' The user has made a change, so set the DataChanged flag to true to
    ' indicate that the record needs to be saved.
    DataChanged = True
End Sub


Private Sub mnuDataIndexISBN_Click()
    Dim db As DATABASE
    Dim bkMark As Variant

    ' Mark the current position.
    bkMark = rs.Bookmark

    ' The user clicked the ISBN choice on the Index pop-oup menu. Set
    ' the recordset index to the primary key, which is the ISBN field.
    rs.Index = "PrimaryKey"

    ' Check the ISBN choice on the menu.
    UpdateMenuStatus "PrimaryKey"

    ' Reset to the marked position.
    rs.Bookmark = bkMark
End Sub

Private Sub mnuDataIndexTitle_Click()
    Dim db As DATABASE
    Dim bkMark As Variant

    ' Mark the current position.
    bkMark = rs.Bookmark

    ' The user clicked the Title choice on the Index pop-oup menu. Set
    ' the recordset index to the Title index.
    rs.Index = "Title"

    ' Check the Title choice on the menu.
    UpdateMenuStatus "Title"

    ' Reset to the marked position.
    rs.Bookmark = bkMark
End Sub

Private Sub mnuDataSeek_Click()
    Dim seekWhat As String
    Dim currentIndex As String
    Dim bkMark As Variant

    ' Mark the current record.
    bkMark = rs.Bookmark

    ' Find out what the currently active index is.

    currentIndex = GetCurrentIndexState()

    ' Get the value(s) from the user to be sought.

    If currentIndex = "ISBN" Then
        seekWhat = InputBox$("ISBN to seek:", "Customer List")
    Else
        seekWhat = InputBox$("State to seek:", "Customer List")
    End If

    ' Seek the requested record. The first argument to the Seek method is
    ' the type of comparison; in this case, it's an equality. The remaining
    ' arguments are the fields in the selected index.

    rs.Seek "=", seekWhat

    ' If the seek was successful, it points the record pointer to the first
    ' record matching the criteria. In this case, just refresh the form.
    ' If the seek was unsuccessful, inform the user and return to the
    ' originally displayed record.

    If Not rs.NoMatch Then
        DisplayRecord
    Else
        MsgBox "Record sought not found!", vbExclamation, "Customer List"
        rs.Bookmark = bkMark
    End If

End Sub
Private Function GetCurrentIndexState() As String

    ' This function returns the name of the currently active index.
    ' It determines the index by seeing which Index menu item is checked.

    If mnuDataIndexISBN.Checked Then
        GetCurrentIndexState = "ISBN"
    Else
        GetCurrentIndexState = "TITLE"
    End If
End Function

Private Sub UpdateMenuStatus(ActiveIndex As String)

    ' This routine places a check mark beside the currently selected indexing
    ' method.

    ' Check the appropriate menu item based on the ActiveIndex argument.
    ' Uncheck all the others.

    mnuDataIndexISBN.Checked = IIf(ActiveIndex = "PrimaryKey", True, False)
    mnuDataIndexTitle.Checked = IIf(ActiveIndex = "Title", True, False)

End Sub